home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / fouran.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  13.3 KB  |  400 lines
  1. /* fouran.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  33.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  34. } flags_;
  35.  
  36. #define flags_1 flags_
  37.  
  38. struct {
  39.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  40.         rstats[50];
  41.     integer iwidth, lwidth, nopage;
  42. } miscel_;
  43.  
  44. #define miscel_1 miscel_
  45.  
  46. struct {
  47.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  48.         sfactr;
  49.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  50.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  51. } status_;
  52.  
  53. #define status_1 status_
  54.  
  55. struct {
  56.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  57.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  58.          pivrel;
  59. } knstnt_;
  60.  
  61. #define knstnt_1 knstnt_
  62.  
  63. struct {
  64.     doublereal tstep, tstop, tstart, delmax, tdmax, forfre;
  65.     integer jtrflg;
  66. } tran_;
  67.  
  68. #define tran_1 tran_
  69.  
  70. struct {
  71.     doublereal xincr, string[15], xstart, yvar[8];
  72.     integer itab[8], itype[8], ilogy[8], npoint, numout, kntr, numdgt;
  73. } outinf_;
  74.  
  75. #define outinf_1 outinf_
  76.  
  77. struct {
  78.     doublereal value[200000];
  79. } blank_;
  80.  
  81. #define blank_1 blank_
  82.  
  83. /* Table of constant values */
  84.  
  85. static integer c__9 = 9;
  86. static integer c__0 = 0;
  87. static integer c__72 = 72;
  88. static integer c__1 = 1;
  89. static integer c__7 = 7;
  90.  
  91. /*<       subroutine fouran >*/
  92. /* Subroutine */ int fouran_()
  93. {
  94.     /* Initialized data */
  95.  
  96.     static struct {
  97.     char e_1[32];
  98.     doublereal e_2;
  99.     } equiv_37 = { {'f', 'o', 'u', 'r', 'i', 'e', 'r', ' ', 'a', 'n', 'a',
  100.          'l', 'y', 's', 'i', 's', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 
  101.         ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  102.  
  103. #define fortit ((doublereal *)&equiv_37)
  104.  
  105.     static struct {
  106.     char e_1[8];
  107.     doublereal e_2;
  108.     } equiv_38 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  109.  
  110. #define ablnk (*(doublereal *)&equiv_38)
  111.  
  112.  
  113.     /* Format strings */
  114.     static char fmt_61[] = "(\002 fourier components of transient response\
  115.  \002,5a8///)";
  116.     static char fmt_71[] = "(\0020dc component =\002,1pd12.3/,\0020harmonic \
  117.   frequency    fourier    normalized    phase     normalized\002/,\002    no\
  118.          (hz)     component    component    (deg)    phase (deg)\002//)";
  119.     static char fmt_81[] = "(i6,1pd15.3,d12.3,0pf13.6,f10.3,f12.3/)";
  120.     static char fmt_101[] = "(//5x,\002total harmonic distortion =  \002,f12\
  121. .6,\002  percent\002)";
  122.  
  123.     /* System generated locals */
  124.     integer i_1, i_2;
  125.     doublereal d_1, d_2;
  126.     complex q_1;
  127.  
  128.     /* Builtin functions */
  129.     double sin(), cos();
  130.     integer s_wsfe(), do_fio(), e_wsfe();
  131.     double sqrt();
  132.  
  133.     /* Local variables */
  134.     static doublereal dcco, harm;
  135.     static integer locx, locy, nknt, loct, ipnt, ipos;
  136.     extern /* Subroutine */ int move_();
  137.     static integer iknt;
  138.     static doublereal freq1;
  139.     extern /* Subroutine */ int getm8_(), zero8_();
  140.     static integer j, k;
  141.     static doublereal phase, cosco[9], sinco[9];
  142.     extern /* Subroutine */ int title_();
  143.     static integer jstop;
  144.     static doublereal xnorm, pnorm;
  145.     extern /* Subroutine */ int ntrpl8_();
  146.     static doublereal forfac;
  147. #define nodplc ((integer *)&blank_1)
  148. #define cvalue ((complex *)&blank_1)
  149.     static doublereal forprd;
  150.     static integer kfrout, numpnt;
  151.     static doublereal arg;
  152.     extern /* Subroutine */ int outnam_();
  153.     static doublereal xnharm;
  154.     extern /* Subroutine */ int magphs_();
  155.     static doublereal phasen, thd;
  156.     extern /* Subroutine */ int clrmem_();
  157.     static doublereal yvr;
  158.  
  159.     /* Fortran I/O blocks */
  160.     static cilist io__22 = { 0, 0, 0, fmt_61, 0 };
  161.     static cilist io__24 = { 0, 0, 0, fmt_71, 0 };
  162.     static cilist io__31 = { 0, 0, 0, fmt_81, 0 };
  163.     static cilist io__35 = { 0, 0, 0, fmt_81, 0 };
  164.     static cilist io__36 = { 0, 0, 0, fmt_101, 0 };
  165.  
  166.  
  167. /*<       implicit double precision (a-h,o-z) >*/
  168.  
  169. /*     this routine determines the fourier coefficients of a transient */
  170. /* analysis waveform. */
  171.  
  172. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  173. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  174. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  175. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  176. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  177. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  178. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  179. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  180. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  181. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  182. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  183. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  184. /* spice version 2g.6  sccsid=flags 3/15/83 */
  185. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  186. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  187. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  188. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  189. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  190. /* spice version 2g.6  sccsid=status 3/15/83 */
  191. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  192. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  193. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  194. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  195. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  196. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  197. /*<      2   pivtol,pivrel >*/
  198. /* spice version 2g.6  sccsid=tran 3/15/83 */
  199. /*<       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg >*/
  200. /* spice version 2g.6  sccsid=outinf 3/15/83 */
  201. /*<       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8), >*/
  202. /*<      1   ilogy(8),npoint,numout,kntr,numdgt >*/
  203. /* spice version 2g.6  sccsid=blank 3/15/83 */
  204. /*<       common /blank/ value(200000) >*/
  205. /*<       integer nodplc(64) >*/
  206. /*<       complex cvalue(32) >*/
  207. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  208.  
  209.  
  210. /*<       dimension sinco(9),cosco(9) >*/
  211. /*<       dimension fortit(4) >*/
  212. /*<       data fortit / 8hfourier , 8hanalysis, 8h        , 8h         / >*/
  213. /*<       data ablnk / 1h  / >*/
  214.  
  215.  
  216. /*<       forprd=1.0d0/forfre >*/
  217.     forprd = 1. / tran_1.forfre;
  218. /*<       xstart=tstop-forprd >*/
  219.     outinf_1.xstart = tran_1.tstop - forprd;
  220. /*<       kntr=1 >*/
  221.     outinf_1.kntr = 1;
  222. /* c    xn=101.0d0 */
  223. /*<       xincr=forprd/npoint >*/
  224.     outinf_1.xincr = forprd / outinf_1.npoint;
  225. /* c    npoint=xn */
  226. /*<       call getm8(locx,npoint) >*/
  227.     getm8_(&locx, &outinf_1.npoint);
  228. /*<       call getm8(locy,npoint) >*/
  229.     getm8_(&locy, &outinf_1.npoint);
  230. /*<       do 105 nknt=1,nfour >*/
  231.     i_1 = tabinf_1.nfour;
  232.     for (nknt = 1; nknt <= i_1; ++nknt) {
  233. /*<       itab(1)=nodplc(ifour+nknt) >*/
  234.     outinf_1.itab[0] = nodplc[tabinf_1.ifour + nknt - 1];
  235. /*<       kfrout=itab(1) >*/
  236.     kfrout = outinf_1.itab[0];
  237. /*<       call ntrpl8(locx,locy,numpnt) >*/
  238.     ntrpl8_(&locx, &locy, &numpnt);
  239. /*<       dcco=0.0d0 >*/
  240.     dcco = 0.;
  241. /*<       call zero8(sinco,9) >*/
  242.     zero8_(sinco, &c__9);
  243. /*<       call zero8(cosco,9) >*/
  244.     zero8_(cosco, &c__9);
  245. /*<       loct=locy+1 >*/
  246.     loct = locy + 1;
  247. /*<       ipnt=0 >*/
  248.     ipnt = 0;
  249. /*<    10 yvr=value(loct+ipnt) >*/
  250. L10:
  251.     yvr = blank_1.value[loct + ipnt - 1];
  252. /*<       dcco=dcco+yvr >*/
  253.     dcco += yvr;
  254. /*<       forfac=dble(ipnt)*twopi/npoint >*/
  255.     forfac = (doublereal) ipnt * knstnt_1.twopi / outinf_1.npoint;
  256. /*<       arg=0.0d0 >*/
  257.     arg = 0.;
  258. /*<       do 20 k=1,9 >*/
  259.     for (k = 1; k <= 9; ++k) {
  260. /*<       arg=arg+forfac >*/
  261.         arg += forfac;
  262. /*<       sinco(k)=sinco(k)+yvr*dsin(arg) >*/
  263.         sinco[k - 1] += yvr * sin(arg);
  264. /*<       cosco(k)=cosco(k)+yvr*dcos(arg) >*/
  265.         cosco[k - 1] += yvr * cos(arg);
  266. /*<    20 continue >*/
  267. /* L20: */
  268.     }
  269. /*<       ipnt=ipnt+1 >*/
  270.     ++ipnt;
  271. /*<       if (ipnt.ne.npoint) go to 10 >*/
  272.     if (ipnt != outinf_1.npoint) {
  273.         goto L10;
  274.     }
  275. /*<       dcco=dcco/npoint >*/
  276.     dcco /= outinf_1.npoint;
  277. /*<       forfac=2.0d0/npoint >*/
  278.     forfac = 2. / outinf_1.npoint;
  279. /*<       do 30 k=1,9 >*/
  280.     for (k = 1; k <= 9; ++k) {
  281. /*<       sinco(k)=sinco(k)*forfac >*/
  282.         sinco[k - 1] *= forfac;
  283. /*<       cosco(k)=cosco(k)*forfac >*/
  284.         cosco[k - 1] *= forfac;
  285. /*<    30 continue >*/
  286. /* L30: */
  287.     }
  288. /*<       call title(0,72,1,fortit) >*/
  289.     title_(&c__0, &c__72, &c__1, fortit);
  290. /*<       ipos=1 >*/
  291.     ipos = 1;
  292. /*<       call outnam(kfrout,1,string,ipos) >*/
  293.     outnam_(&kfrout, &c__1, outinf_1.string, &ipos);
  294. /*<       call move(string,ipos,ablnk,1,7) >*/
  295.     move_(outinf_1.string, &ipos, &ablnk, &c__1, &c__7);
  296. /*<       jstop=(ipos+6)/8 >*/
  297.     jstop = (ipos + 6) / 8;
  298. /*<       write (iofile,61) (string(j),j=1,jstop) >*/
  299.     io__22.ciunit = status_1.iofile;
  300.     s_wsfe(&io__22);
  301.     i_2 = jstop;
  302.     for (j = 1; j <= i_2; ++j) {
  303.         do_fio(&c__1, (char *)&outinf_1.string[j - 1], (ftnlen)sizeof(
  304.             doublereal));
  305.     }
  306.     e_wsfe();
  307. /*<    61 format(' fourier components of transient response ',5a8///) >*/
  308. /*<       write (iofile,71) dcco >*/
  309.     io__24.ciunit = status_1.iofile;
  310.     s_wsfe(&io__24);
  311.     do_fio(&c__1, (char *)&dcco, (ftnlen)sizeof(doublereal));
  312.     e_wsfe();
  313. /*<    71 format('0dc component =',1pd12.3/, >*/
  314. /*<      1   '0harmonic   frequency    fourier    normalized    phase     no >*/
  315. /*<      2rmalized'/, >*/
  316. /*<      3   '    no         (hz)     component    component    (deg)    pha >*/
  317. /*<      4se (deg)'//) >*/
  318. /*<       iknt=1 >*/
  319.     iknt = 1;
  320. /*<       freq1=forfre >*/
  321.     freq1 = tran_1.forfre;
  322. /*<       xnharm=1.0d0 >*/
  323.     xnharm = 1.;
  324. /*<       call magphs(cmplx(sngl(sinco(1)),sngl(cosco(1))),xnorm,pnorm) >*/
  325.     d_1 = sinco[0];
  326.     d_2 = cosco[0];
  327.     q_1.r = d_1, q_1.i = d_2;
  328.     magphs_(&q_1, &xnorm, &pnorm);
  329. /*<       phasen=0.0d0 >*/
  330.     phasen = 0.;
  331. /*<       write (iofile,81) iknt,freq1,xnorm,xnharm,pnorm,phasen >*/
  332.     io__31.ciunit = status_1.iofile;
  333.     s_wsfe(&io__31);
  334.     do_fio(&c__1, (char *)&iknt, (ftnlen)sizeof(integer));
  335.     do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
  336.     do_fio(&c__1, (char *)&xnorm, (ftnlen)sizeof(doublereal));
  337.     do_fio(&c__1, (char *)&xnharm, (ftnlen)sizeof(doublereal));
  338.     do_fio(&c__1, (char *)&pnorm, (ftnlen)sizeof(doublereal));
  339.     do_fio(&c__1, (char *)&phasen, (ftnlen)sizeof(doublereal));
  340.     e_wsfe();
  341. /*<    81 format(i6,1pd15.3,d12.3,0pf13.6,f10.3,f12.3/) >*/
  342. /*<       thd=0.0d0 >*/
  343.     thd = 0.;
  344. /*<       do 90 iknt=2,9 >*/
  345.     for (iknt = 2; iknt <= 9; ++iknt) {
  346. /*<       freq1=dble(iknt)*forfre >*/
  347.         freq1 = (doublereal) iknt * tran_1.forfre;
  348. /*<       call magphs(cmplx(sngl(sinco(iknt)),sngl(cosco(iknt))), >*/
  349. /*<      1   harm,phase) >*/
  350.         d_1 = sinco[iknt - 1];
  351.         d_2 = cosco[iknt - 1];
  352.         q_1.r = d_1, q_1.i = d_2;
  353.         magphs_(&q_1, &harm, &phase);
  354. /*<       xnharm=harm/xnorm >*/
  355.         xnharm = harm / xnorm;
  356. /*<       phasen=phase-pnorm >*/
  357.         phasen = phase - pnorm;
  358. /*<       thd=thd+xnharm*xnharm >*/
  359.         thd += xnharm * xnharm;
  360. /*<       write (iofile,81) iknt,freq1,harm,xnharm,phase,phasen >*/
  361.         io__35.ciunit = status_1.iofile;
  362.         s_wsfe(&io__35);
  363.         do_fio(&c__1, (char *)&iknt, (ftnlen)sizeof(integer));
  364.         do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
  365.         do_fio(&c__1, (char *)&harm, (ftnlen)sizeof(doublereal));
  366.         do_fio(&c__1, (char *)&xnharm, (ftnlen)sizeof(doublereal));
  367.         do_fio(&c__1, (char *)&phase, (ftnlen)sizeof(doublereal));
  368.         do_fio(&c__1, (char *)&phasen, (ftnlen)sizeof(doublereal));
  369.         e_wsfe();
  370. /*<    90 continue >*/
  371. /* L90: */
  372.     }
  373. /*<       thd=100.0d0*dsqrt(thd) >*/
  374.     thd = sqrt(thd) * 100.;
  375. /*<       write (iofile,101) thd >*/
  376.     io__36.ciunit = status_1.iofile;
  377.     s_wsfe(&io__36);
  378.     do_fio(&c__1, (char *)&thd, (ftnlen)sizeof(doublereal));
  379.     e_wsfe();
  380. /*<   101 format (//5x,'total harmonic distortion =  ',f12.6,'  percent') >*/
  381. /*<   105 continue >*/
  382. /* L105: */
  383.     }
  384. /*<       call clrmem(locx) >*/
  385.     clrmem_(&locx);
  386. /*<       call clrmem(locy) >*/
  387.     clrmem_(&locy);
  388. /*<   110 return >*/
  389. /* L110: */
  390.     return 0;
  391. /*<       end >*/
  392. } /* fouran_ */
  393.  
  394. #undef cvalue
  395. #undef nodplc
  396. #undef ablnk
  397. #undef fortit
  398.  
  399.  
  400.